home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / gg / ncurses-5.3.lha / ncurses-5.3 / Ada95 / samples / sample-curses_demo-mouse.adb < prev    next >
Text File  |  2002-10-24  |  9KB  |  222 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                       GNAT ncurses Binding Samples                       --
  4. --                                                                          --
  5. --                         Sample.Curses_Demo.Mouse                         --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 1998 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author:  Juergen Pfeifer, 1996
  37. --  Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en
  38. --  Version Control
  39. --  $Revision: 1.12 $
  40. --  Binding Version 01.00
  41. ------------------------------------------------------------------------------
  42. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  43. with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
  44. with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse;
  45. with Terminal_Interface.Curses.Text_IO; use Terminal_Interface.Curses.Text_IO;
  46. with Terminal_Interface.Curses.Text_IO.Integer_IO;
  47. with Terminal_Interface.Curses.Text_IO.Enumeration_IO;
  48.  
  49. with Sample.Helpers; use Sample.Helpers;
  50. with Sample.Manifest; use Sample.Manifest;
  51. with Sample.Keyboard_Handler; use Sample.Keyboard_Handler;
  52. with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
  53. with Sample.Explanation; use Sample.Explanation;
  54.  
  55. package body Sample.Curses_Demo.Mouse is
  56.  
  57.    package Int_IO is new
  58.      Terminal_Interface.Curses.Text_IO.Integer_IO (Integer);
  59.    use Int_IO;
  60.  
  61.    package Button_IO is new
  62.      Terminal_Interface.Curses.Text_IO.Enumeration_IO (Mouse_Button);
  63.    use Button_IO;
  64.  
  65.    package State_IO is new
  66.      Terminal_Interface.Curses.Text_IO.Enumeration_IO (Button_State);
  67.    use State_IO;
  68.  
  69.    procedure Demo is
  70.  
  71.       type Controls is array (1 .. 3) of Panel;
  72.  
  73.       Frame : Window;
  74.       Msg   : Window;
  75.       Ctl   : Controls;
  76.       Pan   : Panel;
  77.       K     : Real_Key_Code;
  78.       V     : Cursor_Visibility := Invisible;
  79.       W     : Window;
  80.       Note  : Window;
  81.       Msg_L : constant Line_Count := 8;
  82.       Lins  : Line_Position := Lines;
  83.       Cols  : Column_Position;
  84.       Mask  : Event_Mask;
  85.       procedure Show_Mouse_Event;
  86.  
  87.       procedure Show_Mouse_Event
  88.       is
  89.          Evt    : constant Mouse_Event := Get_Mouse;
  90.          Y      : Line_Position;
  91.          X      : Column_Position;
  92.          Button : Mouse_Button;
  93.          State  : Button_State;
  94.          W      : Window;
  95.       begin
  96.          Get_Event (Evt, Y, X, Button, State);
  97.          Put (Msg, "Event at");
  98.          Put (Msg, "  X=");    Put (Msg, Integer (X), 3);
  99.          Put (Msg, ", Y=");    Put (Msg, Integer (Y), 3);
  100.          Put (Msg, ", Btn=");  Put (Msg, Button, 10);
  101.          Put (Msg, ", Stat="); Put (Msg, State, 15);
  102.          for I in Ctl'Range loop
  103.             W := Get_Window (Ctl (I));
  104.             if Enclosed_In_Window (W, Evt) then
  105.                Transform_Coordinates (W, Y, X, From_Screen);
  106.                Put (Msg, ",Box(");
  107.                Put (Msg, Integer (I), 1); Put (Msg, ",");
  108.                Put (Msg, Integer (Y), 1); Put (Msg, ",");
  109.                Put (Msg, Integer (X), 1); Put (Msg, ")");
  110.             end if;
  111.          end loop;
  112.          New_Line (Msg);
  113.          Flush (Msg);
  114.          Update_Panels; Update_Screen;
  115.       end Show_Mouse_Event;
  116.  
  117.    begin
  118.       Push_Environment ("MOUSE00");
  119.       Notepad ("MOUSE-PAD00");
  120.       Default_Labels;
  121.       Set_Cursor_Visibility (V);
  122.  
  123.       Note  := Notepad_Window;
  124.       if Note /= Null_Window then
  125.          Get_Window_Position (Note, Lins, Cols);
  126.       end if;
  127.       Frame := Create (Msg_L, Columns, Lins - Msg_L, 0);
  128.       if Has_Colors then
  129.          Set_Background (Win => Frame,
  130.                          Ch => (Color => Default_Colors,
  131.                                 Attr  => Normal_Video,
  132.                                 Ch    => ' '));
  133.          Set_Character_Attributes (Win   => Frame,
  134.                                    Attr  => Normal_Video,
  135.                                    Color => Default_Colors);
  136.          Erase (Frame);
  137.       end if;
  138.       Msg   := Derived_Window (Frame, Msg_L - 2, Columns - 2, 1, 1);
  139.       Pan   := Create (Frame);
  140.  
  141.       Set_Meta_Mode;
  142.       Set_KeyPad_Mode;
  143.       Mask := Start_Mouse;
  144.  
  145.       Box (Frame);
  146.       Window_Title (Frame, "Mouse Protocol");
  147.       Refresh_Without_Update (Frame);
  148.       Allow_Scrolling (Msg, True);
  149.  
  150.       declare
  151.          Middle_Column : constant Integer := Integer (Columns) / 2;
  152.          Middle_Index  : constant Natural := Ctl'First + (Ctl'Length / 2);
  153.          Width         : constant Column_Count := 5;
  154.          Height        : constant Line_Count   := 3;
  155.          Half          : constant Column_Count := Width / 2;
  156.          Space         : constant Column_Count := 3;
  157.          Position      : Integer;
  158.          W             : Window;
  159.       begin
  160.          for I in Ctl'Range loop
  161.             Position := (Integer (I) - Integer (Middle_Index)) *
  162.               Integer (Half + Space + Width) + Middle_Column;
  163.             W := Create (Height,
  164.                          Width,
  165.                          1,
  166.                          Column_Position (Position));
  167.             if Has_Colors then
  168.                Set_Background (Win => W,
  169.                                Ch => (Color => Menu_Back_Color,
  170.                                       Attr  => Normal_Video,
  171.                                       Ch    => ' '));
  172.                Set_Character_Attributes (Win   => W,
  173.                                          Attr  => Normal_Video,
  174.                                          Color => Menu_Fore_Color);
  175.                Erase (W);
  176.             end if;
  177.             Ctl (I) := Create (W);
  178.             Box (W);
  179.             Move_Cursor (W, 1, Half);
  180.             Put (W, Integer (I), 1);
  181.             Refresh_Without_Update (W);
  182.          end loop;
  183.       end;
  184.  
  185.       Update_Panels; Update_Screen;
  186.  
  187.       loop
  188.          K := Get_Key;
  189.          if K in Special_Key_Code'Range then
  190.             case K is
  191.                when QUIT_CODE     => exit;
  192.                when HELP_CODE     => Explain_Context;
  193.                when EXPLAIN_CODE  => Explain ("MOUSEKEYS");
  194.                when Key_Mouse     => Show_Mouse_Event;
  195.                when others        => null;
  196.             end case;
  197.          end if;
  198.       end loop;
  199.  
  200.       for I in Ctl'Range loop
  201.          W := Get_Window (Ctl (I));
  202.          Clear (W);
  203.          Delete (Ctl (I));
  204.          Delete (W);
  205.       end loop;
  206.  
  207.       Clear (Frame);
  208.       Delete (Pan);
  209.       Delete (Msg);
  210.       Delete (Frame);
  211.  
  212.       Set_Cursor_Visibility (V);
  213.       End_Mouse (Mask);
  214.  
  215.       Pop_Environment;
  216.       Update_Panels; Update_Screen;
  217.  
  218.    end Demo;
  219.  
  220. end Sample.Curses_Demo.Mouse;
  221.  
  222.